package MDBUtils;

# Stop us from shooting outselves in the foot
use strict;
use warnings;

# We need to calculate checksums
use Digest::SHA256;
use Digest::SHA1 qw( sha1_hex );
use Digest::MD5::File qw( file_md5_hex );

# We need to handle compression
use Archive::Zip;
use File::Temp qw( tempdir );
use File::Magic;
use File::Spec;
use File::Basename;
use IPC::Run qw( run );

# We are storing the configuration file in INI format
use Config::IniHash;
use Dir::Self;

sub get_config {

=head1 get_config()

Get the configuration

I<Arguments>

None

I<Returns>

=over

=item $config

A Hash Reference to the configuration.

=back

I<Exceptions>

problems with the distribution extraction, write errors on the file system, ...

=cut

    return ( ReadINI( __DIR__ . "/config.ini" ) );
}

sub filetype {

=head1 filetype( $filename )

Identifies the filetype

I<Arguments>

=over

=item $filename

Full path to filename

=back

I<Returns>

=over

=item $filetype

a human-readable description what kind of data the file contains

=back

I<Exceptions>

problems with the distribution extraction, write errors on the file system, ...

=cut

    my $filename = shift or die("FUNCTION USAGE: mdb_filetype( filename );\n");

    print "MDBUtils::filetype()\n";

    my $magic    = File::Magic->new();
    my $filetype = $magic->type($filename);
    return $filetype;
}

sub compress_zip {
    print "MDBUtils::compress_zip()\n";

    my $src_folder = shift
      or die(
"FUNCTION USAGE: compress_zip( src_folder, dst_filename, [password] );\n"
      );
    my $dst_filename = shift
      or die(
"FUNCTION USAGE: compress_zip( src_folder, dst_filename, [password] );\n"
      );
    my $password = ( shift or "" );

    print "DEBUG: compress_zip( $src_folder , $dst_filename, $password)\n";

    my @args = (
        "7z", "a", length $password > 0 ? "-p" . $password : "",
        "-r", $dst_filename, $src_folder
    );
    my $input  = "";
    my $output = "";
    run( \@args, \$input, \$output );
    if ( $output =~ /Everything is Ok/ ) { return 1; }
    return 0;
}

#######################
# Extract the archive #
#######################
sub extract_archive_zip {

=head1 extract_archive_zip( $filename )

Extracts the files contained in a ZIP archive

I<Arguments>

=over  

=item $filename

Full path to ZIP archive

=back

I<Returns>

=over

=item @filelist

an array with full path to all the extracted files

=back

I<Exceptions>

problems with the distribution extraction, write errors on the file system, ...

=cut

    print "MDBUtils::extract_archive_zip()\n";

    my $filename = shift
      or die("FUNCTION USAGE: extract_archive_zip( filename );\n");
    my $tmpdir = tempdir( CLEANUP => 1 );

    # unzip gets very angry if the file doesn't end with 'zip'
    # we solve it by just sticking ".zip" at the end of the file
    my $new_filename = $filename . ".zip";
    rename( $filename, $new_filename );
    $filename = $new_filename;

    my ( $error, $dir, @flist ) = system_unzip($filename);
    my $no_of_files = scalar(@flist);

    my @filelist;

    # For each file in the archive...
    for ( my $count = 0 ; $count < $no_of_files ; $count++ ) {
        my $file = File::Spec->catfile( $dir, $flist[$count] );
        push( @filelist, $file );
    }
    return (@filelist);
}

#######################
# Extract the archive #
#######################
sub extract_archive_rar {

=head1 extract_archive_rar( $filename )

Extracts the files contained in a RAR archive

I<Arguments>

=over  

=item $filename

Full path to RAR archive

=back

I<Returns>

=over

=iten @filelist

an array with full path to all the extracted files

=back

I<Exceptions>

problems with the distribution extraction, write errors on the file system, ...

=cut

    print "MDBUtils::extract_archive_rar()\n";

    my $filename = shift
      or die("FUNCTION USAGE: extract_archive_rar( filename );\n");
    my $tmpdir = tempdir( CLEANUP => 1 );

    # unrar gets very angry if the file doesn't end with 'rar'
    # we solve it by just sticking ".rar" at the end of the file
    my $new_filename = $filename . ".rar";
    rename( $filename, $new_filename );
    $filename = $new_filename;

    my ( $error, $dir, @flist ) = system_unrar($filename);
    my $no_of_files = scalar(@flist);

    my @filelist;

    # For each file in the archive...
    for ( my $count = 0 ; $count < $no_of_files ; $count++ ) {
        my $file = File::Spec->catfile( $dir, $flist[$count] );
        push( @filelist, $file );
    }
    return (@filelist);
}

sub string_to_file {

=head1 string_to_file( $filename, $data )

Writes $data to file $filename

I<Arguments>

=over  

=item $filename

Full path to output file

=item $data

String to write

=back

I<Returns>

Nothing

I<Exceptions>

problems with the distribution extraction, write errors on the file system, ...

=cut

    my ( $filename, $data ) = @_;

    open( OUTFILE, ">$filename" );
    print OUTFILE $data;
    close(OUTFILE);
}

sub file_to_string {

=head1 $string = file_to_string( $filename )

Reads content of $filename and returns a $string

I<Arguments>

=over  

=item $filename

Full path to input file

=back

I<Returns>

=over

=item $string containing the contents of the file

=back

I<Exceptions>

problems with the distribution extraction, write errors on the file system, ...

=cut

    print "MDBUtils::string_to_file()\n";

    my $filename = shift
      or die("FUNCTION USAGE: file_to_string( filename );\n");
    my $string;

    open( INFILE, "<$filename" );
    while (<INFILE>) {
        $string = $string . $_;
    }
    close(INFILE);
    return $string;
}

##########################################################################
# A small helper function so sha256 works the same way sha1 and md5 does #
##########################################################################
sub mdb_sha256_hex {

=head1 $checksum = mdb_sha256_hex( $filename )

Calculates and returns the sha256 checksum for $filename

I<Arguments>

=over  

=item $filename

Full path to input file

=back

I<Returns>

$string containing the sha256 checksum in hex format

I<Exceptions>

problems with the distribution extraction, write errors on the file system, ...

=cut

    print "MDBUtils::mdb_sha256_hex()\n";

    my $filename = shift or die("FUNCTION USAGE: my_sha256_hex( filename );\n");

    my $sha256 = Digest::SHA256::new("256");

    $sha256->reset();
    $sha256->add( file_to_string($filename) );
    my $result = $sha256->hexdigest();    # Calculate SHA256 checksum
    $result =~ s/\ //g;    # Remove the spaces from the SHA256 checksum

    return $result;
}

##########################################################################
# A small helper function so sha256 works the same way sha1 and md5 does #
##########################################################################
sub mdb_md5_hex {

=head1 $checksum = mdb_md5_hex( $filename )

Calculates and returns the md5 checksum for $filename

I<Arguments>

=over  

=item $filename

Full path to input file

=back

I<Returns>

$string containing the md5 checksum in hex format

I<Exceptions>

problems with the distribution extraction, write errors on the file system, ...

=cut

    print "MDBUtils::mdb_md5_hex()\n";

    my $filename = shift or die("FUNCTION USAGE: my_md5_hex( filename );\n");

    my $result = file_md5_hex($filename);
    return $result;
}

##########################################################################
# A small helper function so sha256 works the same way sha1 and md5 does #
##########################################################################
sub mdb_sha1_hex {

=head1 $checksum = mdb_sha1_hex( $filename )

Calculates and returns the sha1 checksum for $filename

I<Arguments>

=over  

=item $filename

Full path to input file

=back

I<Returns>

$string containing the sha1 checksum in hex format

I<Exceptions>

problems with the distribution extraction, write errors on the file system, ...

=cut

    print "MDBUtils::mdb_sha1_hex()\n";

    my $filename = shift or die("FUNCTION USAGE: my_sha1_hex( filename );\n");

    my $result = sha1_hex( file_to_string($filename) );
    return $result;
}

# gets:
#  zipname - exact location (relative/absolute) of zip archive
#  [directory] - directory in which to extract(optional)
# returns:
#  (err(undef == ok), directory, fname)
sub system_unzip {
    my ( $fname, $dir ) = @_;
    if ( !defined($dir) ) {
        $dir = tempdir( CLEANUP => 1 );
    }

    my $ziperrlogfile = "ziperrlog-" . rand_string();
    system(
        "unzip -P infected -d \"$dir\" \"$fname\" 2>$ziperrlogfile 1>/dev/null"
    );
    my $error = undef;

    # test for "bad CRC" at unzip
    {
        open my ($hzl), $ziperrlogfile;
        while (<$hzl>) {
            if ( index( $_, "bad CRC" ) >= 0 ) {
                $error = "bad crc";
                last;
            }
        }
        close $hzl;
    }
    if ( $? == -1 ) {
        $error = "failed to execute unzip: $!";
    }
    elsif ( $? & 127 ) {
        printf "child died with signal %d, %s coredump\n", ( $? & 127 ),
          ( $? & 128 ) ? 'with' : 'without';
    }
    else {
        ;    #printf "child exited with value %d\n", $? >> 8;
    }
    unlink $ziperrlogfile;
    my @flist;

    # reading the folder contents
    my $dirh;
    if ( opendir $dirh, $dir ) {
        while ( my $ff = readdir $dirh ) {
            if ( -f "$dir/$ff" ) {
                push @flist, $ff;
            }
        }
        closedir $dirh;
    }
    else {
        $error = "could not opendir($dir)";
    }

    if ( defined($error) ) {
        return ( $error, $dir, undef );
    }
    else {
        return ( undef, $dir, @flist );
    }
}

# gets:
#  rarname - exact location (relative/absolute) of zip archive
#  [directory] - directory in which to extract(optional)
# returns:
#  (err(undef == ok), directory, fname)
sub system_unrar {
    my ( $fname, $dir ) = @_;
    if ( !defined($dir) ) {
        $dir = tempdir( CLEANUP => 1 );
    }

    my $rarerrlogfile = "rarerrlog-" . rand_string();
    system(
        "unrar -pinfected x \"$fname\"  \"$dir\" 2>$rarerrlogfile 1>/dev/null"
    );
    my $error = undef;

    # test for "bad CRC" at unrar
    {
        open my ($hzl), $rarerrlogfile;
        while (<$hzl>) {
            if ( index( $_, "bad CRC" ) >= 0 ) {
                $error = "bad crc";
                last;
            }
        }
        close $hzl;
    }
    if ( $? == -1 ) {
        $error = "failed to execute unrar: $!";
    }
    elsif ( $? & 127 ) {
        printf "child died with signal %d, %s coredump\n", ( $? & 127 ),
          ( $? & 128 ) ? 'with' : 'without';
    }
    else {
        ;    #printf "child exited with value %d\n", $? >> 8;
    }
    unlink $rarerrlogfile;
    my @flist;

    # reading the folder contents
    my $dirh;
    if ( opendir $dirh, $dir ) {
        while ( my $ff = readdir $dirh ) {
            if ( -f "$dir/$ff" ) {
                push @flist, $ff;
            }
        }
        closedir $dirh;
    }
    else {
        $error = "could not opendir($dir)";
    }

    if ( defined($error) ) {
        return ( $error, $dir, undef );
    }
    else {
        return ( undef, $dir, @flist );
    }
}

sub rand_string {
    my ($len) = @_;
    $len ||= 12;

    my @chars = ( 'A' .. 'Z', 'a' .. 'z', '0' .. '9' );
    my @r;
    my $l = scalar @chars;
    foreach ( 1 .. $len ) {
        $r[ $_ - 1 ] = $chars[ rand($l) ];
    }
    return join '', @r;
}

1;
